IMPLEMENTATION MODULE Tad_ArbolBinomial;

FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM SYSTEM  IMPORT TSIZE;
FROM StrIO    IMPORT WriteString, WriteLn; 
FROM NumberIO IMPORT WriteInt; 
FROM FpuIO IMPORT WriteReal;
IMPORT Tad_Lista;

TYPE 
    Arbol = POINTER TO RECORD
						cabeza : MonticuloBinomial;
						END;
    

    MonticuloBinomial = POINTER TO RECORD
						  clave 	: REAL;
						  elemento	: ADDRESS;
						  grado 	: CARDINAL;
						  hijo  	: MonticuloBinomial;
						  hermano	: MonticuloBinomial;
						  padre		: MonticuloBinomial;
					   END;
  
PROCEDURE CrearArbol():Arbol;
VAR a:Arbol;
BEGIN
	NEW(a);
	IF a = NIL THEN
		RETURN NIL;
	END;
	a^.cabeza := NIL;
	RETURN a;
END CrearArbol;

PROCEDURE Agregar(VAR a:Arbol; e:ADDRESS; clave: REAL);
VAR m: MonticuloBinomial;
BEGIN

        NEW(m);
        IF m=NIL THEN
                RETURN;
        END;
        m^.clave := clave;
        m^.elemento := e;
        Insertar(a,m);
END Agregar;
       
PROCEDURE GetMaximo(a:Arbol):ADDRESS;
VAR maximo 		: ADDRESS;
	monticulo 	: MonticuloBinomial;
	claveMaxima	: REAL;
BEGIN
	maximo := NIL;
	monticulo := a^.cabeza;
	claveMaxima := - 1000.0;
	WHILE monticulo <> NIL DO
		IF monticulo^.clave > claveMaxima THEN
			claveMaxima := monticulo^.clave;
			maximo := monticulo^.elemento;
		END;
		monticulo := monticulo^.hermano;
	END;
	RETURN maximo;
END GetMaximo;       

PROCEDURE Enlazar(VAR m1: MonticuloBinomial; VAR m2: MonticuloBinomial);
VAR hermano	: MonticuloBinomial;
	padre 	: MonticuloBinomial;
	hijo 	: MonticuloBinomial;
BEGIN
	IF(m1<>m2) THEN
		m1^.padre := m2;
		IF (m2 <> m1^.hermano) THEN
			m2^.hermano := m1^.hermano;
		END;
		m1^.hermano := m2^.hijo;
		m2^.hijo := m1;
		m2^.grado := m2^.grado + 1;
		
	END;
END Enlazar;      

PROCEDURE Mezclar(VAR a1: Arbol; VAR a2: Arbol);
VAR m1	: MonticuloBinomial;
	m2	: MonticuloBinomial;
	m3	: MonticuloBinomial;
BEGIN
	m1 := a1^.cabeza;
	m2 := a2^.cabeza;
	a1^.cabeza := MenorGrado(m1,m2);
	IF a1^.cabeza = NIL THEN 
		RETURN;
	END;
	IF a1^.cabeza = m2 THEN
		m2 := m1;
	END;
	m1 := a1^.cabeza;
	WHILE m2 <> NIL DO
		IF m1^.hermano = NIL THEN
			m1^.hermano := m2;
			RETURN;
		ELSIF m1^.hermano^.grado < m2^.grado THEN
			m1 := m1^.hermano;
		ELSE 
			m3 := m2^.hermano;
			m2^.hermano := m1^.hermano;
			m1^.hermano := m2;
			m1 := m1^.hermano;
			m2 := m3;
		END;
	END;
END Mezclar;

PROCEDURE Union(a1: Arbol; a2: Arbol):Arbol;
VAR a 			: Arbol;
	anterior 	: MonticuloBinomial;
	siguiente	: MonticuloBinomial;
	monticulo	: MonticuloBinomial;
BEGIN
	a := CrearArbol();
	Mezclar(a1,a2);
	a^.cabeza := a1^.cabeza;
	a1 := NIL;
	a2 := NIL;
	IF a^.cabeza = NIL THEN 
		RETURN a;
	END;
	anterior := NIL;
	monticulo := a^.cabeza;

	siguiente := monticulo^.hermano;
	WHILE siguiente <> NIL DO
		IF (monticulo^.grado <> siguiente^.grado) OR 
		((siguiente^.hermano <> NIL) AND (
		siguiente^.hermano^.grado = monticulo^.grado)) THEN
			anterior := monticulo;
			monticulo := siguiente;
		ELSIF monticulo^.clave >= siguiente^.clave THEN
			monticulo^.hermano := siguiente^.hermano;
			Enlazar(siguiente,monticulo);
		ELSE
			IF anterior = NIL THEN
				a^.cabeza := siguiente;
			ELSE 
				anterior^.hermano := siguiente;
			END;
			Enlazar(monticulo,siguiente);
			monticulo := siguiente;	
		END;
		siguiente := monticulo^.hermano;	
	END; 
	RETURN a;

END Union;
 
PROCEDURE Insertar(VAR a:Arbol;VAR m:MonticuloBinomial);
VAR a1: Arbol;
BEGIN
	a1:= CrearArbol();
	m^.padre := NIL;
	m^.hijo := NIL;
	m^.hermano := NIL;
	m^.grado := 0;
	a1^.cabeza := m;
	a := Union(a,a1);
END Insertar;

PROCEDURE MenorGrado(m1: MonticuloBinomial; m2: MonticuloBinomial):MonticuloBinomial;
BEGIN
        IF (m1 = NIL) AND (m2 <> NIL) THEN
                RETURN m2;
        ELSIF (m1 <> NIL) AND (m2 = NIL) THEN
                RETURN m1
        ELSIF (m1 = NIL) AND (m2 = NIL) THEN
                RETURN NIL;
        END;

        IF (m1^.grado < m2^.grado) THEN
                RETURN m1;
        END;
        RETURN m2;
END MenorGrado;
             
PROCEDURE ExtraerMaximo( VAR a : Arbol ):ADDRESS;
VAR maximo                 : MonticuloBinomial;
BEGIN
        maximo := ExtraerMonticuloMaximo(a);
        RETURN maximo^.elemento;
END ExtraerMaximo;

PROCEDURE ExtraerMonticuloMaximo(VAR a:Arbol):MonticuloBinomial;
VAR maximo                 : MonticuloBinomial;
        monticulo         : MonticuloBinomial;
        anterior,aux: MonticuloBinomial;
        hermano                : MonticuloBinomial;
        hijo                : MonticuloBinomial;
        siguiente                : MonticuloBinomial;
        claveMaxima        : REAL;
        a1                        : Arbol;
BEGIN
        (*Obtengo el elemento a eliminar*)
        maximo := NIL;
        anterior := NIL;
        monticulo := a^.cabeza;
        claveMaxima := - 1000.0;
        WHILE monticulo <> NIL DO
                IF monticulo^.clave > claveMaxima THEN
                        claveMaxima := monticulo^.clave;
                        maximo := monticulo;
                        aux := anterior;
                END;
                anterior := monticulo;
                monticulo := monticulo^.hermano;        
        END;
        anterior := aux;
        (*Si tengo un hermano izquierdo*)
        IF anterior <> NIL THEN
                (*Si tengo ademas un hermano derecho*)
                IF maximo^.hermano <> NIL THEN
                        (*Enlazo mi hermano izquierdo con el derecho*)
                        anterior^.hermano := maximo^.hermano;
                (*Si no tengo hermano derecho*)
                ELSE
                        (*Elimino el enlace hacia el maximo*)
                        anterior ^.hermano := NIL;
                END;
        ELSE
                (*Si tengo un hermano derecho*)
                IF maximo^.hermano <> NIL THEN
                        (*Mi hermano será la nueva cabeza*)
                        a^.cabeza := maximo^.hermano;
                (*Si no tengo hermano derecho*)
                ELSE
                        (*Elimino el enlace hacia el maximo*)
                        a^.cabeza := NIL;
                END;
        END;
        a1 := CrearArbol();
        (*Revertir la lista de hijos del maximo*)
        IF maximo^.hijo <> NIL THEN
                monticulo := maximo^.hijo;
                siguiente := monticulo^.hermano;
                monticulo^.hermano :=  NIL;
                WHILE siguiente <> NIL DO
                        hermano := siguiente^.hermano;
                        siguiente^.hermano := monticulo;
                        monticulo := siguiente;
                        siguiente := hermano;
                END;
        END;
        a1^.cabeza := monticulo;
        a := Union(a,a1);
        RETURN maximo;
END ExtraerMonticuloMaximo;

PROCEDURE IncrementarClave(a:Arbol; m: MonticuloBinomial; k: REAL);
VAR m1          : MonticuloBinomial; 
        p                : MonticuloBinomial; 
        clave        : REAL;
        elem        : ADDRESS;
BEGIN
        IF k < m^.clave THEN
                RETURN;
                (*La clave ya es la mayor*)
        ELSE
                m^.clave := k;
                m1 := m;
                p := m1^.padre;        
        END;
        WHILE (p<>NIL) AND (m1^.clave > p^.clave) DO
                clave := m1^.clave;
                elem := m1^.elemento;
                (*Intercambiar claves y elementos*)
                m1^.clave := p^.clave;
                p^.clave := clave;
                m1^.elemento := p^.elemento;
                p^.elemento := elem;
                m1 := p;
                p := m1^.padre;
        END;
END IncrementarClave;

PROCEDURE Delete(VAR a:Arbol; m:MonticuloBinomial);
VAR x:MonticuloBinomial;
BEGIN
        IncrementarClave(a,m,10000.0);
        x := ExtraerMaximo(a);
END Delete;

PROCEDURE Imprimir ( a : Arbol );
BEGIN
        IF a = NIL THEN
                RETURN;
        END;

        Imprimir_Monticulo(a^.cabeza);

END Imprimir;

PROCEDURE Imprimir_Monticulo ( mon : MonticuloBinomial );
BEGIN

        IF mon = NIL THEN
                RETURN;
        ELSE
                WriteReal(mon^.clave,5,0);
                WriteLn;
                WriteString('Hno  ');
                WriteReal(mon^.clave,5,0);
                WriteLn;
                Imprimir_Monticulo(mon^.hermano);
                WriteString('Hijo  ');
                WriteReal(mon^.clave,5,0);
                WriteLn;
                Imprimir_Monticulo(mon^.hijo);
                WriteLn;
        END;

END Imprimir_Monticulo;


PROCEDURE ListaOrdenada ( a : Arbol; function : funImprimir ) : Tad_Lista.Lista;
VAR l :Tad_Lista.Lista;
VAR valido : BOOLEAN;
BEGIN
        IF a = NIL THEN
                RETURN NIL;
        END;
        
        l := Tad_Lista.Crear_Lista(function);

        WHILE a^.cabeza <> NIL DO
                valido := Tad_Lista.Lista_Agregar(l,ExtraerMaximo(a));
                IF NOT valido THEN
                        RETURN l;
                END;
        END;

RETURN l;
END ListaOrdenada;

PROCEDURE Clonar (a : Arbol) : Arbol;
VAR clon : Arbol;
VAR m : MonticuloBinomial;
BEGIN
        clon := CrearArbol();
        IF (a = NIL) THEN
                RETURN NIL;
        END;
        m := a^.cabeza;
        ClonarMonticulo(m,clon);
        RETURN clon;
END Clonar;

PROCEDURE ClonarMonticulo ( m : MonticuloBinomial; VAR clon : Arbol);
VAR m1 : MonticuloBinomial;
BEGIN
        NEW(m1);
        IF (m1 = NIL) OR (clon = NIL) THEN
                RETURN;
        END;
        m1^.clave := m^.clave;
        m1^.elemento := m^.elemento;
        Insertar(clon,m1);
        IF m^.hermano <> NIL THEN
                ClonarMonticulo(m^.hermano,clon);
        END;
        IF m^.hijo <> NIL THEN
                ClonarMonticulo(m^.hijo,clon);
        END;
END ClonarMonticulo;
END Tad_ArbolBinomial.
